package Zim::Store::Files;

use strict;
use File::Spec;
use File::MimeInfo;
use Zim::Store::Cached;

our $VERSION = '0.20';
our @ISA = qw/Zim::Store::Cached/;

=head1 NAME

Zim::Store::Files - A file system based repository

=head1 DESCRIPTION

This module implements a file system based repository for zim.
See L<Zim::Store> for the interface documentation.

=head1 METHODS

=over 4

=item C<new(PARENT, NAMESPACE, DIR)>

Simple constructor. DIR is the root directory of the repository.
NAMESPACE is the namespace that maps to that directory.

=cut

sub init { # called by new
	my $self = shift;
	$self->check_dir;

	$self->{config}{read_only} = (-w $self->{dir}) ? 0 : 1;
	$self->{format} ||= 'wiki';
	$self->{ext} = ($self->{format} eq 'html')     ? 'html' :
	               ($self->{format} eq 'txt2tags') ? 't2t'  : 'txt' ;
		# FIXME HACK FIXME - this belongs in a Formats.pm
	
	$self->SUPER::init();
	
	return $self;
}

sub _search { # query is a hash ref with options etc
	my ($self, $query, $callback, $ns) = @_;
	$ns ||= $self->{namespace};
	warn "Searching $ns\n";
	
	my $reg = $$query{regex};
	unless ($reg) {
		$reg = quotemeta $$query{string};
		$reg = "\\b".$reg."\\b" if $$query{word};
		$reg = "(?i)".$reg unless $$query{case};
		$reg = qr/$reg/;
		#warn $reg;
		$$query{regex} = $reg;
	}
	
	for ($self->list_pages($ns)) {
		my $p = $ns.$_;
		my $is_dir = ($p =~ s/:$//);
		my $match = ($p =~ $reg) ? 1 : 0 ;
		$match += $self->file($p)->grep($reg, 'count');
		$callback->($match ? [$p, $match] : ());
		$self->_search($query, $callback, $p.':') if $is_dir; # recurs
	}
}

=item C<get_page(PAGE_NAME)>

Returns an object of the type L<Zim::Page>.

=cut

sub get_page {
	my ($self, $name, $source) = @_; # source is a private argument
	$source ||= $self->file($name); # case sensitive lookup

	my $page = Zim::Page->new($self, $name);
	$page->set_source($source);
	$page->set_format($self->{format});

	$page->properties->{base} = $source->dir;
	unless ($source->exists) {
		$page->{parse_tree} = $self->_template($page);
		$page->status('new');
	}
	$page->properties->{read_only} = $self->{config}{read_only};

	return $page;
}

=item C<resolve_case(\@LINK, \@PAGE)>

See L<Zim::Store>.

=cut

sub resolve_case {
	my ($self, $link, $page) = @_;
	my $match;
	if ($page and @$page) {
		#warn "resolve_case: @$link @ @$page\n";
		my $anchor = shift @$link;
		for (reverse  -1 .. $#$page) {
			my $t = ':'.join(':', @$page[0..$_], $anchor);
			#warn "\ttrying: $t\n";
			## FIXME FIXME optimize the two below together
			my $file = $self->file($t, 1);
			my $dir = $self->dir($t, 1);
			next unless -f $file or -d $dir;
			$match = join ':', $t, @$link;
			last;
		}
	}
	else { $match = ':' . join ':', @$link } # absolute

	return undef unless $match;
	my $file = $self->file($match, 1);
	return $self->pagename($file);
}

#sub resolve_page {
#	my ($self, $name) = @_;
#	my $source = $self->file($name, 1); # case tolerant lookup
#	#warn "Resolved $name => $source\n";
#	$name = $self->pagename($source->path);
#	return defined($name) ? $self->get_page($name, $source) : undef;
#}

sub _template {
	# FIXME should use Zim::Formats->bootstrap_template()
	my ($self, $page) = @_;
	$page->name =~ /([^:]+):*$/;
	my $title = ucfirst($1);
	$title =~ s/_/ /g;

	unless (defined $self->{_template_new}) {
		my $template = Zim::Formats->lookup_template(
				$self->{format}, '_New' );
		if ($template) {
			eval 'require Zim::Template'; die $@ if $@;
			$self->{_template_new} = Zim::Template->new($template);
		}
		else { $self->{_template_new} = 0 }
	}

	return ['Page', {%{$page->properties}}, ['head1', {}, $title]]
		unless $self->{_template_new};

	my ($fh, $text);
	my $data = { title => $title };
	$self->{_template_new}->process($data => \$text);
	
	# FIXME: duplicate code form Page.pm
	open $fh, '<', \$text;
	my $tree = $page->{format}->load_tree($fh, $page);
	%{$tree->[1]} = (%{$page->{properties}}, %{$tree->[1]});
	return $tree;
}

=item C<copy_page(SOURCE, TARGET, UPDATE_LINKS)>

=cut

sub copy_page {
	my ($self, $old, $new, $update) = @_;
	my $source = $self->file($old);
	my $target = $self->file($new);
	Zim::File->copy($source, $target);
	@$new{'status', 'parse_tree'} = ('', undef);
	if ($update) {
		my ($from, $to) = ($source->name, $target->name);
		$self->get_page($_)->update_links($from => $to)
			for $source->list_backlinks ;
	}
}

=item C<move_page(SOURCE, TARGET)>

=cut

sub move_page {
	my ($self, $old, $new) = @_;
	
	# Move file
	my $source = $self->file($old);
	my $target = $self->file($new);

	die "No such page: $source\n" unless $source->exists;
	#warn "Moving $source to $target\n";
	Zim::File->move($source, $target);

	# update objects
	@$old{'status', 'parse_tree'} = ('deleted', undef);
	@$new{'status', 'parse_tree'} = ('', undef);
	$self->_cache_page($old);
	$self->_cache_page($new);
}

=item C<delete_page(PAGE)>

=cut

sub delete_page {
	my ($self, $page) = @_;

	my $file = $self->file($page);
	my $dir = $file->dir;
	if ($file->exists) { $file->remove }
	else { # border case where empty dir was left for some reason
		$dir = $self->dir($page);
		Zim::File->remove_dir($dir);
	}
	
	@$page{'status', 'parse_tree'} = ('deleted', undef) if ref $page;
	$self->_cache_page($page);
}

=item C<search()>

TODO

=cut

sub search {
	my ($self, $page, $query) = @_;
	
}

=back

=head2 Private methods

=over 4

=item C<file(PAGE, NOCASE)>

Returns a L<Zim::File> object for a page name.

NOCASE is a boolean that triggers a case in-sensitive lookup when true.

=item C<dir(PAGE, NOCASE)>

Returns a dir for a page name. This dir maps to the namespace below this page.

NOCASE is a boolean that triggers a case in-sensitive lookup when true.

=cut

sub file {
	my ($self, $page, $case_tolerant) = @_;
	#warn "Looking up filename for: $page\n";

	if (ref $page) {
		# Page has a file object already
		return $page->{source} if defined $page->{source};
		$page = $page->name;
	}

	# Special case for top level
	if ($page eq $self->{indexpage}) { $page = '_index' }
	else { $page =~ s/^\Q$$self{namespace}\E//i }

	# Split and decode
	my @parts =
		map {s/\%([A-Fa-z0-9]{2})/chr(hex($1))/eg; $_}
		grep length($_), split /:+/, $page;

	# Search file path
	my $file = $case_tolerant
		? Zim::File->resolve_file({ext => $$self{ext}}, $$self{dir}, @parts)
		: join('/', $$self{dir}, @parts).'.'.$$self{ext} ;
	#warn "\t=> $file\n";

	# Create file object
	$file = $self->root->{config}{slow_fs}
		? Zim::File::CacheOnWrite->new($file)
		: Zim::File::CheckOnWrite->new($file) ;
	return $file;
}

sub dir {
	my ($self, $page, $case_tolerant) = @_;

	my $root = $self->{dir};
	$page = $page->name if ref $page;

	if ($page eq $self->{indexpage}) { return $root }
	else { $page =~ s/^\Q$self->{namespace}\E//i }
	my @parts =
		map {s/\%([A-Fa-z0-9]{2})/chr(hex($1))/eg; $_}
		grep length($_), split /:+/, $page;

	my $dir = $case_tolerant
		? Zim::File->resolve_file(
			{ext => $$self{ext}, is_dir => 1}, $root, @parts)
		: join('/', $root, @parts)  ;

	return $dir;
}

=item C<pagename(FILE)>

Returns the page name corresponding to FILE. FILE does not actually
need to exist and can be a directory as well as a file.

=cut

sub pagename {
	my ($self, $file) = @_;
	#warn "looking up pagename for: $file\n";
	$file = File::Spec->abs2rel($file, $self->{dir})
		if File::Spec->file_name_is_absolute($file);
	my @parts =
		map {s/([^[:alnum:]_\.\-\(\)])/sprintf("%%%02X",ord($1))/eg; $_}
		grep length($_), File::Spec->splitdir($file);
	return undef unless @parts;
	$parts[-1] =~ s/\.\Q$$self{ext}\E$//;
	return $self->{indexpage} if $parts[-1] =~ /^_index$/i;
	return $self->{namespace} . join ':', @parts;
}

1;

__END__

=back

=head1 BUGS

Please mail the author if you find any bugs.

=head1 AUTHOR

Jaap Karssenberg || Pardus [Larus] E<lt>pardus@cpan.orgE<gt>

Copyright (c) 2005 Jaap G Karssenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<Zim>, L<Zim::Store::Cached>, L<Zim::Page>

=cut
